home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue39 / construc / DRBOBCGI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-06  |  2.6 KB  |  120 lines
  1. unit DrBobCGI;
  2. {$I-}
  3. interface
  4. type
  5.   TRequestMethod = (Unknown,Get,Post);
  6. var
  7.   RequestMethod: TRequestMethod = Unknown;
  8.  
  9. var
  10.   ContentLength: Integer = 0;
  11.   RemoteAddress: String[16] = ''; // TDM #39
  12.   HttpUserAgent: String[128] = ''; // TDM #39
  13.   Data: AnsiString = '';
  14.  
  15.   function Value(const Field: ShortString): ShortString;
  16.  
  17. implementation
  18. uses
  19.   Windows, SysUtils;
  20.  
  21.   function Value(const Field: ShortString): ShortString;
  22.   var
  23.     i: Integer;
  24.     len: Byte absolute Result;
  25.   begin
  26.     Len := 0;
  27.     i := Pos('&'+Field+'=',Data);
  28.     if i = 0 then
  29.     begin
  30.       i := Pos(Field+'=',Data);
  31.       if i > 1 then i := 0
  32.     end
  33.     else Inc(i); { skip '&' }
  34.     if i > 0 then
  35.     begin
  36.       Inc(i,Length(Field)+1);
  37.       while Data[i] <> '&' do
  38.       begin
  39.         Inc(Len);
  40.         Result[Len] := Data[i];
  41.         Inc(i)
  42.       end
  43.     end;
  44.     if Result = '' then Result := '@'
  45.   end {Value};
  46.  
  47. var
  48.   P: PChar;
  49.   i: Integer;
  50.   Str: ShortString;
  51.  
  52. initialization
  53.   P := GetEnvironmentStrings;
  54.   while P^ <> #0 do
  55.   begin
  56.     Str := StrPas(P);
  57.     if Pos('REQUEST_METHOD=',Str) > 0 then
  58.     begin
  59.       Delete(Str,1,Pos('=',Str));
  60.       if Str = 'POST' then RequestMethod := Post
  61.       else
  62.         if Str = 'GET' then RequestMethod := Get
  63.     end
  64.     else
  65.     if Pos('CONTENT_LENGTH=',Str) = 1 then
  66.     begin
  67.       Delete(Str,1,Pos('=',Str));
  68.       ContentLength := StrToInt(Str)
  69.     end
  70.     else
  71.     if Pos('QUERY_STRING=',Str) > 0 then
  72.     begin
  73.       Delete(Str,1,Pos('=',Str));
  74.       SetLength(Data,Length(Str)+1);
  75.       Data := Str
  76.     end
  77.     else
  78.     if Pos('REMOTE_ADDR',Str) = 1 then // TDM #39
  79.     begin
  80.       Delete(Str,1,Pos('=',Str));
  81.       RemoteAddress := Str
  82.     end
  83.     else
  84.     if Pos('HTTP_USER_AGENT',Str) = 1 then // TDM #39
  85.     begin
  86.       Delete(Str,1,Pos('=',Str));
  87.       if Pos(')',Str) > 0 then
  88.         Delete(Str,Pos(')',Str)+1,Length(Str)); {!!}
  89.       HttpUserAgent := Str;
  90.     end;
  91.     Inc(P, StrLen(P)+1)
  92.   end;
  93.   if RequestMethod = Post then
  94.   begin
  95.     SetLength(Data,ContentLength+2);
  96.     for i:=1 to ContentLength do read(Data[i]);
  97.     Data[ContentLength+1] := '&';
  98.   { if IOResult <> 0 then { skip }
  99.   end;
  100.   i := 0;
  101.   while i < Length(Data) do
  102.   begin
  103.     Inc(i);
  104.     if Data[i] = '+' then Data[i] := ' ';
  105.     if Data[i] = '%' then { special code }
  106.     begin
  107.       Str := '$00';
  108.       Str[2] := Data[i+1];
  109.       Str[3] := Data[i+2];
  110.       Delete(Data,i+1,2);
  111.       Data[i] := Chr(StrToInt(Str))
  112.     end
  113.   end;
  114.   if i > 0 then Data[i+1] := '&'
  115.            else Data := '&'
  116. finalization
  117.   Data := ''
  118. end.
  119.  
  120.